home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / studchain.sim < prev    next >
Text File  |  1993-08-16  |  18KB  |  439 lines
  1. % ****************************************************************
  2. % *                                                              *
  3. % *  This is the program constructed in section 14.3 of          *
  4. % *  Object Oriented Programming with Simula by Bj|rn Kirkerud;  *
  5. % *                                                              *
  6. % ****************************************************************
  7.  
  8. begin
  9.  
  10. % ****************************************************************
  11. % *                                                              *
  12. % *  Declarations of auxiliary procedures:                       *
  13. % *                                                              *
  14. % ****************************************************************
  15.  
  16.   character procedure prompt_for_char(prompt);  text prompt;
  17.     begin
  18.       outtext(prompt); breakoutimage; inimage;
  19.       prompt_for_char := inchar;
  20.     end of prompt_for_char;
  21.  
  22.   integer procedure prompt_for_int(prompt);  text prompt;
  23.     begin
  24.       outtext(prompt); breakoutimage; inimage;
  25.       prompt_for_int := inint;
  26.     end of prompt_for_int;
  27.  
  28.   real procedure prompt_for_real(prompt);  text prompt;
  29.     begin
  30.       outtext(prompt); breakoutimage; inimage;
  31.       prompt_for_real := inreal;
  32.     end of prompt_for_real;
  33.  
  34.   Boolean procedure prompt_for_bool(prompt);  text prompt;
  35.     begin character c;
  36.       outtext(prompt); breakoutimage; inimage;
  37.       c := inchar;
  38.       prompt_for_bool := c = 'y' or c = 'Y';
  39.     end of prompt_for_bool;
  40.  
  41.   procedure User_message(message); text message;
  42.     begin outtext(message); outimage end;
  43.  
  44.   text procedure int_as_text(int); integer int;
  45.     begin text t;
  46.       t :- blanks(size_of_int(int));
  47.       t.putint(int);
  48.       int_as_text :- t;
  49.     end;
  50.  
  51.   integer procedure size_of_int(int); integer int;
  52.     begin integer a;
  53.       a := abs(int);
  54.       size_of_int := (if int < 0 then 1 else 0) +
  55.                      (if a < 10 then 1 else
  56.                       if a < 100 then 2 else
  57.                       if a < 1000 then 3 else
  58.                       if a < 10000 then 4 else
  59.                       if a < 100000 then 5 else
  60.                       if a < 1000000 then 6 else
  61.                       if a < 10000000 then 7 else
  62.                       if a < 100000000 then 8 else
  63.                       if a < 1000000000 then 9 else 10);
  64.     end;
  65.  
  66.  
  67. % ****************************************************************
  68. % *                                                              *
  69. % *  The class Student:                                          *
  70. % *                                                              *
  71. % ****************************************************************
  72.  
  73.   class Student;
  74.     begin
  75.  
  76.       integer ident, year, month, day, form;
  77.       Boolean female;
  78.       character math_grade, eng_grade, hist_grade;
  79.  
  80.       text procedure key; key :- int_as_text(ident);
  81.  
  82.     ! A variable to hold a reference to the next Student in a pointer chain:   ;
  83.       ref(Student) next_in_chain;
  84.  
  85.       procedure read;
  86.         begin
  87.           ident           := prompt_for_int("Identity number? ");
  88.           year            := prompt_for_int("Year of birth? ");
  89.           month        := prompt_for_int("Month? ");
  90.           day            := prompt_for_int("Day? ");
  91.           form            := prompt_for_int("Form? ");
  92.           female        := prompt_for_bool("Female? ");
  93.           math_grade        := prompt_for_char("Grade in mathematics? ");
  94.           eng_grade        := prompt_for_char("Grade in English? ");
  95.           hist_grade        := prompt_for_char("Grade in history? ");
  96.         end of Student'read;
  97.  
  98.       procedure write;
  99.         begin
  100.           outtext("Data for student: "); outint(ident, 6);
  101.           outtext(".  Born: ");    outint(day,     2);   outchar('/');
  102.              outint(month,   2);   outchar('/');
  103.              outint(year,    4);
  104.           outtext(if female then ".  Female."  else ".  Male."); outimage;
  105.           outtext("  Form: "); outint(form, 1);
  106.           outtext(".  Current grades:");
  107.             outtext("  Mathematics: ");  outchar(math_grade);
  108.             outtext("  English: ");      outchar(eng_grade);
  109.             outtext("  History: ");      outchar(hist_grade); outimage;
  110.         end of Student'write;
  111.  
  112.       procedure change;
  113.         begin character attribute;
  114.           attribute := prompt_for_char("What do you want  to change? ");
  115.           if attribute = 'i' then ident      
  116.              := prompt_for_int("New identity number? ")    else
  117.           if attribute = 'y' then year       
  118.              := prompt_for_int("New birth year? ")       else
  119.           if attribute = 'm' then month      
  120.              := prompt_for_int("New birth month? ")        else
  121.           if attribute = 'd' then day        
  122.              := prompt_for_int("New day of birth? ")       else
  123.           if attribute = 'f' then form       
  124.              := prompt_for_int("New form number? ")        else
  125.           if attribute = 's' then female     
  126.              := prompt_for_bool("Female? ")                else
  127.           if attribute = 'a' then math_grade 
  128.              := prompt_for_char("New grade in  math? ")    else
  129.           if attribute = 'e' then eng_grade  
  130.              := prompt_for_char("New grade in  English? ") else
  131.  
  132.           if attribute = 'h' then hist_grade 
  133.              := prompt_for_char("New grade in  history? ")
  134.         else begin
  135.               User_message("You can change one of the  following attributes:");
  136.               User_message("  i: Identity number");  
  137.               User_message("  y: Birth year");
  138.               User_message("  m: Birth month");    
  139.               User_message("  d: Day of birth");
  140.               User_message("  f: Form number");    
  141.               User_message("  s: Sex");
  142.               User_message("  a: Grade in mathematics");
  143.               User_message("  e: Grade in English");
  144.               User_message("  h: Grade in history");
  145.               change; ! Observe that this is an invocation of the procedure 
  146.                       ! being declared. The effect is that user is given
  147.                       ! another chance to change;
  148.             end;
  149.         end of Student'change;
  150.  
  151.       character procedure worst_grade;
  152.         worst_grade := max(math_grade, max(eng_grade,  hist_grade));
  153.  
  154.       procedure put_in_record(outf); ref(outfile) outf;
  155.         inspect outf do 
  156.           begin
  157.             outint(ident, 6);
  158.             outint(year, 5); outint(month, 3); outint(day, 3); 
  159.             outint(form, 2); outint(if female then 1 else 0, 2);
  160.             outchar(math_grade); outchar(eng_grade); outchar(hist_grade); 
  161.           end;
  162.  
  163.       procedure get_from_record(inf); ref(infile) inf;
  164.         inspect inf do 
  165.           begin
  166.             ident := inint;
  167.             year := inint; month := inint; day := inint; 
  168.             form := inint; female := inint = 1;
  169.             math_grade := inchar; eng_grade := inchar; hist_grade := inchar; 
  170.           end;
  171.         
  172.  
  173.     end of Student;
  174.  
  175.  
  176. % ****************************************************************
  177. % *                                                              *
  178. % *  The class School:                                           *
  179. % *                                                              *
  180. % ****************************************************************
  181.  
  182.   class School;
  183.       protected first_in_chain, last_in_traversal;
  184.     begin
  185.  
  186.     ! Declaration of a variable to hold a reference to the first Student  
  187.     ! in the pointer chain:  ;
  188.       ref(Student) first_in_chain;
  189.  
  190.     ! Declaration of a variable to hold a reference to the Student
  191.     ! last vistited in a traversal of the chain:  ;
  192.       ref(Student) last_in_traversal;
  193.  
  194.     !   Declarations of data access procedures:   ;
  195.  
  196.       procedure Place_student(a_student, student_exists);
  197.           name student_exists; ref(Student) a_student;  Boolean student_exists;
  198.         begin
  199.           student_exists := false;
  200.           if first_in_chain == none
  201.             then first_in_chain :- a_student    
  202.                   ! The new object is placed first;
  203.           else if a_student.key < first_in_chain.key
  204.             then begin
  205.               a_student.next_in_chain :- first_in_chain;
  206.               first_in_chain :- a_student;       
  207.                   ! The new object is placed first;
  208.             end
  209.           else begin ref(Student) aux_stud;  Boolean aux_found;
  210.               aux_stud :- first_in_chain;  aux_found := false;
  211.               while not aux_found do
  212.                 if aux_stud.next_in_chain == none  then aux_found := true
  213.                 else if a_student.key <  aux_stud.next_in_chain.key  
  214.                      then aux_found := true
  215.                 else aux_stud :- aux_stud.next_in_chain;
  216.               if a_student.key = aux_stud.key
  217.                 then student_exists := true
  218.                 else begin
  219.                     a_student.next_in_chain :- aux_stud.next_in_chain;
  220.                     aux_stud.next_in_chain  :- a_student;    
  221.                       ! The new object is placed after aux_stud;
  222.                   end;
  223.             end;
  224.         end of Place_student;
  225.  
  226.       ref(Student) procedure find_student(key);  text key;
  227.           ! This version assumes that the pointer chain is sorted  
  228.           ! on increasing key-values;
  229.         begin ref(Student) aux_stud; Boolean found;
  230.           aux_stud :- first_in_chain;
  231.           while aux_stud =/= none and not found do
  232.             if aux_stud.key > key then aux_stud :- none else
  233.             if aux_stud.key = key then found := true
  234.             else aux_stud :- aux_stud.next_in_chain;
  235.           find_student :- aux_stud;
  236.         end of find_student;
  237.  
  238.       ref(Student) procedure first_student;
  239.         begin 
  240.           first_student :- first_in_chain;  
  241.           last_in_traversal :- first_in_chain;
  242.         end;
  243.  
  244.       ref(Student) procedure next_student;
  245.         if last_in_traversal == none then next_student :- none
  246.         else begin
  247.             last_in_traversal :- last_in_traversal.next_in_chain;
  248.             next_student      :- last_in_traversal;
  249.           end;
  250.  
  251.       procedure Remove_specified_student(key, no_such_student);
  252.           name no_such_student; text key;  Boolean no_such_student;
  253.         begin  ref(Student) aux_stud, pred_stud; Boolean found;
  254.           aux_stud :- first_in_chain;
  255.           while aux_stud =/= none and not found do
  256.             if aux_stud.key = key then found := true
  257.             else begin
  258.               pred_stud :- aux_stud;
  259.               aux_stud  :- aux_stud.next_in_chain;
  260.             end;
  261.           if aux_stud == none then no_such_student := true
  262.           else begin
  263.             no_such_student := false;
  264.             if pred_stud == none
  265.               then first_in_chain          :- first_in_chain.next_in_chain
  266.               else pred_stud.next_in_chain :- aux_stud.next_in_chain;
  267.           end;
  268.         end of Remove_student;
  269.  
  270.     end of School;
  271.  
  272.  
  273. % ****************************************************************
  274. % *                                                              *
  275. % *   Start of School-context:                                   *
  276. % *                                                              *
  277. % ****************************************************************
  278.  
  279.   School begin
  280.  
  281.  
  282. % ****************************************************************
  283. % *                                                              *
  284. % *  Declarations of command procedures:                         *
  285. % *                                                              *
  286. % ****************************************************************
  287.  
  288.       procedure Give_help;
  289.         begin
  290.           User_message("The legal commands are: "); 
  291.           User_message("   ?:  Help (writes this text)"); 
  292.           User_message("   N:  To enter data about a new student"); 
  293.           User_message("   W:  Writes data about a specified student"); 
  294.           User_message("   L:  Writes a list with all students"); 
  295.           User_message("   C:  Changes data about a specified student"); 
  296.           User_message("   R:  Removes all data about a specified student"); 
  297.           User_message("   P:  Puts all data to file ""stud.dta"""); 
  298.           User_message("   G:  Gets data from file ""stud.dta"""); 
  299.           User_message("   B:  Writes students with bad grades"); 
  300.           User_message("   Q:  Quit (the program execution stops)"); 
  301.         end of Give_help;
  302.  
  303.       procedure Enter_student;
  304.         begin  ref(Student) a_student; Boolean ident_exists;
  305.           a_student :- new Student;
  306.           a_student.read;
  307.           Place_student(a_student, ident_exists);
  308.           if ident_exists
  309.             then User_message("The identity number is already  in use!")
  310.             else User_message("The data have been stored.");
  311.         end of Enter_student;
  312.  
  313.       procedure Write_student;
  314.         begin integer ident_number; ref(Student) a_student;
  315.           ident_number := prompt_for_int("Identity number? ");
  316.           a_student    :- find_student(int_as_text(ident_number));
  317.           if a_student == none
  318.             then User_message("No student with that  identity number!")
  319.             else a_student.write;
  320.         end of Write_student;
  321.  
  322.       procedure List_students;
  323.         begin ref(Student) a_student;
  324.           User_message("The students for which data have  been entered:");
  325.           a_student :- first_student;
  326.           while a_student =/= none do
  327.             begin a_student.write;  a_student :- next_student end;
  328.         end of List_students;
  329.  
  330.       procedure Change_student;
  331.         begin ref(Student) a_student; integer ident_number;
  332.           ident_number := prompt_for_int("Identity number? ");
  333.           a_student :- find_student(int_as_text(ident_number));
  334.           if a_student == none
  335.             then User_message("No student with that  identity number!")
  336.             else begin a_student.write;  a_student.change end;
  337.         end of Change_student;
  338.  
  339.       procedure Remove_student;
  340.         begin integer ident_number;  Boolean no_such_student;
  341.           ident_number := prompt_for_int("Identity number? ");
  342.           Remove_specified_student(int_as_text(ident_number),  no_such_student);
  343.           if no_such_student
  344.             then User_message("No student with that identity  number!")
  345.             else User_message("The student has been removed!");
  346.         end of Remove_student;
  347.  
  348.       procedure Put_to_file;
  349.         begin ref(Student) a_student;
  350.           inspect new outfile("stud.dta") do
  351.             begin
  352.               open(blanks(24));
  353.               a_student :- first_student;
  354.               while a_student =/= none do
  355.                 begin
  356.                   a_student.put_in_record(this outfile);
  357.                   outimage;
  358.                   a_student :- next_student;
  359.                 end;
  360.               close;
  361.             end;
  362.         end of Put_to_file;
  363.  
  364.       procedure Get_from_file;
  365.         begin ref(Student) a_student; Boolean ident_exists;
  366.           inspect new infile("stud.dta") do
  367.             begin
  368.               open(blanks(24)); inimage;
  369.               while not endfile do
  370.                 begin
  371.                   a_student :- new Student;
  372.                   a_student.get_from_record(this infile);
  373.                   Place_student(a_student, ident_exists);
  374.                   inimage;
  375.                 end;
  376.               close;
  377.             end;
  378.         end of Get_from_file;
  379.  
  380.       procedure Bad_grades;
  381.         begin character grade_limit;  ref(Student) a_student;
  382.           grade_limit := prompt_for_char("Grade limit? ");
  383.           a_student :- first_student;
  384.           while a_student =/= none do
  385.             begin
  386.               if a_student.worst_grade ge grade_limit  then a_student.write;
  387.               a_student :- next_student;
  388.             end;
  389.         end of Bad_grades;
  390.  
  391.  
  392.       procedure Unknown_command(c); character c;
  393.         begin
  394.           outtext("   You gave the command '"); outchar(c);
  395.           outtext("'.  This is not among the legal commands.");  outimage;
  396.           outtext("   Type ? if you don't remember the legal commands"); 
  397.           outimage;
  398.         end of Unknown command;
  399.  
  400.  
  401. % ****************************************************************
  402. % *                                                              *
  403. % *  Declaration of a variable to keep the latest command        *
  404. % *  typed by the user:                                          *
  405. % *                                                              *
  406. % ****************************************************************
  407.  
  408.   character command;
  409.  
  410.  
  411. % ****************************************************************
  412. % *                                                              *
  413. % *  That was the last declaration.                              *
  414. % *  Now come the imperatives of the program:                    *
  415. % *                                                              *
  416. % ****************************************************************
  417.  
  418.   command := prompt_for_char("Type your first command  (? for help) > ");
  419.   while command ne 'Q' do
  420.     begin
  421.       if command = '?' then Give_help         else
  422.       if command = 'N' then Enter_student  else
  423.       if command = 'W' then Write_student  else
  424.       if command = 'L' then List_students  else
  425.       if command = 'C' then Change_student else
  426.       if command = 'R' then Remove_student else
  427.       if command = 'P' then Put_to_file    else
  428.       if command = 'G' then Get_from_file  else
  429.       if command = 'B' then Bad_grades
  430.       else Unknown_command(command);
  431.       command := prompt_for_char("Your next command > ");
  432.     end;
  433.  
  434.   User_message("Bye");
  435.  
  436. end of block prefixed by School;
  437.  
  438. end
  439.